home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 021-030 / amok25 / microtimer / microtimer.mod < prev    next >
Text File  |  1993-11-04  |  3KB  |  132 lines
  1. (*
  2.   :Program.       MicroTimer.mod
  3.   :Author.        Volker Rudolph
  4.   :Address.       Medicusstr. 31 / 6750 Kaiserslautern
  5.   :Phone.         0631/17160
  6.   :Copyright.     PD
  7.   :Language.      Modula-II
  8.   :Translator.    M2Amiga 3.2d
  9.   :History.       V1.1 V. Rudolph 24.4.1989
  10.   :Contents.      MicroTimer ermöglicht sehr präzise Zeitmessungen.
  11. *)
  12.  
  13. IMPLEMENTATION MODULE MicroTimer;
  14.  
  15. FROM Arts IMPORT Assert, TermProcedure;
  16. FROM Hardware IMPORT CiaCraFlagSet,CiaCraFlags,CiaCrbFlagSet,CiaCrbFlags,
  17.   UByte, ciab;
  18. FROM SYSTEM IMPORT ADR;
  19.  
  20. CONST
  21.   MAXINT = MAX(LONGINT);
  22.  
  23.   (* Umrechung CIA-Ticks in Mikrosekunden. *)
  24.   (* Sollte eigentlich Systemtakt / 10 sein (0.716), liefert aber dann *)
  25.   (* eine falsche Zeit. Durch ausprobieren habe ich diesen besseren    *)
  26.   (* Wert gefunden *)
  27.   TickToMicro = 0.7088;
  28.  
  29.   (* Maximale Anzahl von Ticks bis zum LONGINT-Overflow *)
  30.   maxTicks = LONGINT(LONGREAL(MAXINT) * TickToMicro);
  31.  
  32. TYPE
  33.   (* Konversion: Vier einzelne Bytes in LONGINT *)
  34.   Convert = RECORD
  35.               CASE :BOOLEAN OF
  36.                 TRUE: byte3:UByte;
  37.                       byte2:UByte;
  38.                       byte1:UByte;
  39.                       byte0:UByte;
  40.                |FALSE:ticks:LONGINT;
  41.               END; (* CASE *)
  42.             END;
  43.  
  44. VAR
  45.   running:BOOLEAN;
  46.  
  47. (* TermProcedure : Beide Timer stoppen *)
  48. PROCEDURE StopIt;
  49. BEGIN
  50.   IF running THEN
  51.     running := FALSE;
  52.     ciab.cra := CiaCraFlagSet{};
  53.     ciab.crb := CiaCrbFlagSet{};
  54.   END; (* IF *)
  55. END StopIt;
  56.  
  57. (* Timer starten *)
  58. PROCEDURE StartTimer;
  59. VAR
  60.   inUse:BOOLEAN;
  61. BEGIN
  62.   inUse := (crbStart IN ciab.crb) OR (craStart IN ciab.cra);
  63.   Assert(NOT inUse, ADR("MicroTimer : Timer already in use"));
  64.   running := TRUE;
  65.   WITH ciab DO
  66.     (* Beide Timer auf MAXINT stellen *)
  67.     tbhi := 07FH;
  68.     tblo := 0FFH;
  69.     tahi := 0FFH;
  70.     talo := 0FFH;
  71.     (* Timer b mit Timer a koppeln und Startzeit von Timer b laden *)
  72.     crb := CiaCrbFlagSet{crbLoad,crbStart,crbRunmode,crbInmode1};
  73.     (* Timer a mit Startzeit laden und starten *)
  74.     cra := CiaCraFlagSet{craLoad,craStart};
  75.   END; (* WITH *)
  76. END StartTimer;
  77.  
  78. (* Zeit auslesen während Timer läuft *)
  79. PROCEDURE LookTimer(VAR micros:LONGINT);
  80. VAR
  81.   conv:Convert;
  82.   ok:BOOLEAN;
  83. BEGIN
  84.   WITH ciab DO
  85.     WITH conv DO
  86.       (* Zeit auslesen, bei Fehler wiederholen bis ok *)
  87.       REPEAT
  88.         byte3 := tbhi;
  89.         byte2 := tblo;
  90.         ok :=        (tbhi = byte3);
  91.         byte1 := tahi;
  92.         ok := ok AND (tblo = byte2);
  93.         byte0 := talo;
  94.         ok := ok AND (tahi = byte1);
  95.       UNTIL ok;
  96.     END; (* WITH *)
  97.   END; (* WITH *)
  98.  
  99.   (* Verstrichene Zeit berechnen *)
  100.   micros := (MAXINT - conv.ticks);
  101.  
  102.   (* Ist maximale Meßdauer überschritten ? *)
  103.   IF micros > maxTicks THEN
  104.     micros := 0;
  105.   ELSE
  106.     (* In Microsekunden umrechnen *)
  107.     micros := LONGINT(LONGREAL(micros) / TickToMicro);
  108.   END; (* IF *)
  109.  
  110. END LookTimer;
  111.  
  112. (* Timer stoppen *)
  113. PROCEDURE StopTimer(VAR micros:LONGINT);
  114. BEGIN
  115.   StopIt;
  116.   LookTimer(micros);
  117. END StopTimer;
  118.  
  119. (* Mikrosekunden in Minuten, Sekunden und restliche Micros umrechnen *)
  120. PROCEDURE MicrosToTime(VAR minutes, seconds:CARDINAL;VAR micros:LONGINT;
  121.   inputMicros:LONGINT);
  122. BEGIN
  123.    minutes :=  inputMicros DIV (1000000 * 60);
  124.    seconds := (inputMicros DIV  1000000) MOD 60;
  125.    micros  :=  inputMicros MOD  1000000;
  126. END MicrosToTime;
  127.  
  128. BEGIN
  129.   running := FALSE;
  130.   TermProcedure(StopIt);
  131. END MicroTimer.
  132.